home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbtool.exe / MENUBAR2.BAS < prev    next >
BASIC Source File  |  1991-11-27  |  6KB  |  125 lines
  1. '----------------------------------------------------------
  2. '  PROGRAM: MENUBAR2.BAS       PROGRAMMER: A. KELLETT
  3. '  DATE-WRITTEN: 11/27/91
  4. '  USING POWER BASIC V2.10A
  5. '
  6. '  THIS PROGRAM ALLOWS THE USER TO MAKE CHOICES FROM A
  7. '  MENU BAR ACROSS THE TOP OF THE SCREEN.  PLEASE NOTE
  8. '  THAT ONLY 3 LINES NEED CHANGING IF YOU WANT THE MENUBAR
  9. '  LOCATED SOMEWHERE BESIDES LINE 1 (IE BOTTOM MENU BAR)
  10. '  THIS VERSION ALSO DISPLAYS AN EXPLANATORY LINE...
  11. '  VERSION: 1.00    LAST UPDATED: 00/00/00
  12. '----------------------------------------------------------
  13. $INCLUDE "KEYS.INC"
  14. $INCLUDE "COLORS.INC"
  15. CLS
  16. DIM MENU$(1:8)
  17. DIM MENU%(1:8)
  18. DIM MENU2$(1:8)
  19. LOWVAL% = 1:HIVAL% = 8 :REM** LOW/HI VALUES FOR THE CHOICES (VALID RANGE) **
  20.  
  21. '  NOTE: Please be sure that all MENU2$() elements are the same length and
  22. '        that the rightmost empty spaces (if any) are padded with spaces...
  23. '
  24. '** MENU CHOICES **** COLUMN TO LOCATE IT IN ***
  25. MENU$(1) = "1 Files   ":MENU%(1) = 1 :MENU2$(1) = "File utilities: copy, delete, list, view, print files       "
  26. MENU$(2) = "2 Compile ":MENU%(2) = 11:MENU2$(2) = "Compile: with or without debug, with or without symbols     "
  27. MENU$(3) = "3 Editor  ":MENU%(3) = 21:MENU2$(3) = "Edit: edit source, executable, or binary files              "
  28. MENU$(4) = "4 Options ":MENU%(4) = 31:MENU2$(4) = "Options: remote communications, file transfers              "
  29. MENU$(5) = "5 Debugger":MENU%(5) = 41:MENU2$(5) = "Debugger: debug while viewing source or assembler code      "
  30. MENU$(6) = "6 Host Sys":MENU%(6) = 51:MENU2$(6) = "Host Sys: use this PC as a transparent host terminal        "
  31. MENU$(7) = "7 Network ":MENU%(7) = 61:MENU2$(7) = "Network: use this PC as a transparent network station       "
  32. MENU$(8) = "8 Exit-Dos":MENU%(8) = 71:MENU2$(8) = "Exit: leave this menu system and exit to PC-DOS             "
  33. REM** <<ALL>> VALID KEYS THE USER CAN PRESS **
  34. KEYTOPRESS$ = " 12345678" + LEFTARROW$ + RIGHTARROW$ + CR$
  35.  
  36. CALL SCROLLBAR(MENU$(), MENU2$(), MENU%(), 1, 1, LOWVAL%, HIVAL%, KEYTOPRESS$, CHOICE%)
  37.  
  38. LOCATE 22,15:PRINT "YOU CHOSE OPTION ";CHOICE%
  39.  
  40. END
  41. '  YOU NEED BOTH SUBROUTINES (SCROLLBAR AND LITEBAR3) IN YOUR PROGRAM.
  42. '  MENU$()   - ARRAY CONTAINING THE MENU TEXT FOR ALL CHOICES
  43. '  MENU2$()  - ARRAY CONTAINING MENU CHOICE EXPLANATIONS
  44. '  LOWVAL%   - LOWEST CHOICE, SHOULD <ALWAYS> BE 1 !
  45. '  HIVAL%    - HIGHEST CHOICE, FOR 10 ITEM MENU SHOULD BE 10
  46. '  VALIDKEY$ - SHOULD CONTAIN ANY KEYS YOU WILL ALLOW FOR
  47. '              IE. VALIDKEYS$ = " 012345678" + LEFTARROW$ + RIGHTARROW$ + CR$
  48. '              BE SURE THE INITIAL SPACE IS LEFT IN AND SEE CHARS.INC FOR
  49. '              PREDEFINED KEYS YOU CAN USE FOR READABILITY.
  50. '  KEYPRESS% - CONTAINS A NUMBER REPRESENTING WHICH MENU CHOICE WAS
  51. '              HILIGHTED WHEN THE USER PRESSED THE <ENTER> KEY
  52. '  NOTES: THIS ROUTINE DOES NOT CHECK WHETHER LENGTH OF ALL MENU CHOICES
  53. '         ARE LONGER THAN 80 CHARACTERS (LESS THAN 80 IS NO PROBLEM).  YOU
  54. '         MUST SET UP THE MENU$() AND MENU%() CORRECTLY BEFORE CALLING THIS
  55. '         ROUTINE.
  56. '
  57. '----------------------------------------------------------
  58. SUB SCROLLBAR(MENU$(), MENU2$(), MENU%(), OLD.POS%, NEW.POS%, LOWVAL%, HIVAL%, VALIDKEY$, KEYPRESS%)
  59.    SHARED LEFTARROW$, RIGHTARROW$, CR$
  60.    QUITFLAG% = 0:OLD.POS% = 1:NEW.POS% = 1
  61.    '**** DISPLAY INITIAL MENU CHOICES ****
  62.    FOR I% = LOWVAL% TO HIVAL%
  63.       LOCATE 1, MENU%(I%)   :REM** CHANGE TO ANOTHER LINE IF NEEDED **
  64.       PRINT MENU$(I%);
  65.    NEXT I%
  66.    LOCATE 20,15:PRINT "PRESS <Enter> TO EXIT"
  67.    '**** LOOP UNTIL USER PRESSES <RETURN> KEY ****
  68.    WHILE QUITFLAG% = 0
  69.       CALL LITEBAR4(MENU$(), MENU2$(), OLD.POS%, NEW.POS%, MENU%())
  70.       DO
  71.          KEYIN$ = INKEY$
  72.       LOOP UNTIL INSTR(VALIDKEY$, KEYIN$) > 1
  73.       IF (KEYIN$ = "0" OR KEYIN$ = CR$) THEN
  74.          KEYPRESS% = NEW.POS%  :REM** WHICH KEY WAS THE CHOICE ON ?? **
  75.          QUITFLAG% = 1         :REM** EXIT THIS SUBROUTINE **
  76.       ELSE
  77.          IF (KEYIN$ = LEFTARROW$ AND NEW.POS% > LOWVAL%) THEN
  78.             OLD.POS% = NEW.POS%
  79.             NEW.POS% = NEW.POS% - 1
  80.             CALL LITEBAR4(MENU$(), MENU2$(), OLD.POS%, NEW.POS%, MENU%())
  81.          ELSE
  82.             IF (KEYIN$ = RIGHTARROW$ AND NEW.POS% < HIVAL%) THEN
  83.                OLD.POS% = NEW.POS%
  84.                NEW.POS% = NEW.POS% + 1
  85.                CALL LITEBAR4(MENU$(), MENU2$(), OLD.POS%, NEW.POS%, MENU%())
  86.             ELSE
  87.                IF (KEYIN$ = LEFTARROW$ AND NEW.POS% = 1) THEN
  88.                   OLD.POS% = 1
  89.                   NEW.POS% = HIVAL%
  90.                   CALL LITEBAR4(MENU$(), MENU2$(), OLD.POS%, NEW.POS%, MENU%())
  91.                ELSE
  92.                   IF (KEYIN$ = RIGHTARROW$ AND NEW.POS% = HIVAL%) THEN
  93.                      OLD.POS% = HIVAL%
  94.                      NEW.POS% = 1
  95.                      CALL LITEBAR4(MENU$(), MENU2$(), OLD.POS%, NEW.POS%, MENU%())
  96.                   ELSE
  97.                      IF (KEYIN$ <> LEFTARROW$ AND KEYIN$ <> RIGHTARROW$) THEN
  98.                         NEW.POS% = VAL(KEYIN$)
  99.                         CALL LITEBAR4(MENU$(), MENU2$(), OLD.POS%, NEW.POS%, MENU%())
  100.                      END IF
  101.                   END IF
  102.                END IF
  103.             END IF
  104.          END IF
  105.       END IF
  106.    WEND
  107.  
  108. END SUB
  109. '
  110. '
  111. '----------------------------------------------------------
  112. SUB LITEBAR4(MENU$(), MENU2$(), OLD.POS%, NEW.POS%, MENU%())
  113.    SHARED BLACK%, HIGH.INTENSITY.WHITE%, WHITE%
  114.    LOCATE 1, MENU%(OLD.POS%)  :REM** CHANGE TO ANOTHER LINE IF NEEDED **
  115.    COLOR WHITE%, BLACK%:PRINT MENU$(OLD.POS%);:COLOR BLACK%, WHITE%
  116.    '*** NOW HILIGHT NEW CHOICE ***
  117.    COLOR BLACK%, HIGH.INTENSITY.WHITE%
  118.    LOCATE 1, MENU%(NEW.POS%)  :REM** CHANGE TO ANOTHER LINE IF NEEDED **
  119.    PRINT MENU$(NEW.POS%);:COLOR WHITE%, BLACK%
  120.    OLD.POS% = NEW.POS%
  121.    LOCATE 2,1:PRINT MENU2$(NEW.POS%);
  122.  
  123. END SUB
  124.  
  125.